home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Shareware World / Comms & Internet / HTML and CSS modes / HTML and CSS Modes / htmlUtils.tcl < prev   
Text File  |  1998-11-01  |  66KB  |  2,177 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlUtils.tcl"
  6.  #                                    created: 96-09-01 13.01.43 
  7.  #                                last update: 98-11-01 17.01.32 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.1.3
  13.  # 
  14.  # Copyright 1996-1998 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc htmlUtils.tcl {} {}
  25.  
  26. #
  27. # Mark file
  28. #
  29. proc HTML::parseFuncs {} {
  30.     return [htmlMarkFile2 0]
  31. }
  32.  
  33. proc HTML::MarkFile {} {
  34.     htmlMarkFile2 1
  35.     message "Marks set."
  36. }
  37.  
  38. proc htmlMarkFile2 {markfile} {
  39.     set pos 0
  40.     set exp {<[Hh][1-6][^>]*>}
  41.     set exp2 {</[Hh][1-6]>}
  42.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp $pos} rs] && 
  43.     ![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp2 [lindex $rs 1]} res]} {
  44.         set start [lindex $rs 0]
  45.         set end [lindex $res 1]
  46.         set text [getText $start $end]
  47.         # Remove tabs and returns from text.
  48.         regsub -all "\[\t\r\]+" $text " " text
  49.         # remove all tags from text
  50.         set headtext [htmlTagStrip $text]
  51.         # Set mark only on one line.
  52.         if {$end > [nextLineStart $start]} {
  53.             set end [expr [nextLineStart $start] - 1]
  54.         }
  55.         
  56.         set indlevel [getText [expr $start + 2] [expr $start + 3]]
  57.  
  58.         if {$indlevel > 0 && $indlevel < 7} {
  59.             set lab [string range "       " 2 $indlevel]
  60.             append lab $lab $indlevel " " $headtext
  61.             # Cut the menu item if it's longer than 30 letters, not to make it too long.
  62.             if {[string length $lab] > 30} {
  63.                 set lab "[string range $lab 0 29]…"
  64.             }
  65.             if {$markfile} {
  66.                 setNamedMark $lab $start $start $end
  67.             } else {
  68.                 lappend parse $lab [lineStart $start]
  69.             }
  70.         }
  71.         set pos $end
  72.     }
  73.     if {!$markfile} {return $parse}
  74. }
  75.  
  76.  
  77. #
  78. # return positions of tags of including elements, as a list of 5 elements --
  79. # openstart openend closestart closeend elementname.
  80. # Elements without a closing tag are ignored.
  81. # args: point to start search backward from; point which must be enclosed
  82. #
  83. # if any problem, return just {0}
  84. #
  85. proc htmlGetContainer {curPos inclPos} {
  86.  
  87.     set startPos $curPos
  88.     set startPos2 $inclPos
  89.     set searchFinished 0
  90.     message "Searching for enclosing tags…"
  91.     while {!$searchFinished} {
  92.         # find first tag
  93.         set isStartTag 0
  94.         while {!$isStartTag} {
  95.             if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $startPos} res]} {
  96.                 message ""
  97.                 return {0}
  98.             }
  99.             set tag1start [lindex $res 0]
  100.             set tag1end   [lindex $res 1]
  101.             # get element name
  102.             if {![regexp {<([^ \t\r]+).*>} [getText $tag1start $tag1end] tmp tag]} {
  103.                 message ""
  104.                 return {0}
  105.             }
  106.             # is this a closing tag?
  107.             if {[string index $tag 0] != "/"} { set isStartTag 1}
  108.             set startPos [expr $tag1start - 1]
  109.         }
  110.         # find closing tag
  111.         set res [htmlGetClosing $tag $tag1end]
  112.         
  113.         set tag2start [lindex $res 0]
  114.         set tag2end   [lindex $res 1]
  115.         # If container enclosed along with us, or there is no closing tag,
  116.         # continue searching.
  117.         if {![llength $res] || $tag2end < $inclPos} {
  118.             set startPos [expr $tag1start - 1]
  119.         } else {
  120.             set Container "$tag1start $tag1end $tag2start $tag2end" 
  121.             set searchFinished 1
  122.         }
  123.     }
  124.     
  125.     message ""
  126.     return [concat $Container [string toupper $tag]]
  127. }
  128.  
  129.  
  130. #
  131. # return position an opening tag if the first element to the left
  132. # of startPos is an element with only an opening tag, as a list of 3 elements --
  133. # openstart openend elementname.
  134. #
  135. # if any problem, return empty string
  136. #
  137.  
  138. proc htmlGetOpening {startPos} {
  139.     
  140.     while {1} {
  141.         if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $startPos} res]} {
  142.             return
  143.         }
  144.         set tag1start [lindex $res 0]
  145.         set tag1end   [lindex $res 1]
  146.         # get element name
  147.         if {![regexp {<([^ \t\r]+).*>} [getText $tag1start $tag1end] tmp tag]} {
  148.             return
  149.         }
  150.         # is this a closing tag?
  151.         if {[string index $tag 0] == "/"} {return}
  152.         # comment?
  153.         if {[string range $tag 0 2] != "!--"} {break}
  154.         set startPos [expr $tag1start - 1]
  155.     }
  156.     
  157.     # find closing tag
  158.     set res [htmlGetClosing $tag $tag1end]
  159.     
  160.     if {![llength $res] } {
  161.         return "$tag1start $tag1end [string toupper $tag]"
  162.     } else {
  163.         return
  164.     }
  165.     
  166. }
  167.  
  168. proc htmlGetClosing {tag sPos} {
  169.     set x </${tag}>
  170.     set sPos2 $sPos
  171.     while {1} {
  172.         set res [search -s -f 1 -r 1 -i 1 -m 0 -n $x $sPos]
  173.         # Found any closing tag.
  174.         if {![llength $res]} {break}
  175.         # Look for another opening tag of the same element.
  176.         set y "<${tag}(\[ \\t\\r\]+|>)"
  177.         set res2 [search -s -f 1 -r 1 -i 1 -m 0 -n $y $sPos2]
  178.         # Is it further away than the closing tag.
  179.         if {![llength $res2] || [lindex $res2 0] > [lindex $res 0]} {break}
  180.         # If not, find the next closing tag.
  181.         set sPos [lindex $res 1]
  182.         set sPos2 [lindex $res2 1]
  183.     }
  184.     return $res
  185. }
  186.  
  187. # Change choice of an attribute with pre-defined choices.
  188. proc htmlChangeChoice {} {
  189.     set pos [expr [getPos] - 1]
  190.     if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $pos} res] ||
  191.     [lindex $res 1] < $pos || 
  192.     ![regexp {<([^ \t\r>]+)} [eval getText $res] tmp tag] ||
  193.     [catch {search -s -f 0 -r 1 -i 0 -m 0 {[ \t\r]+[^=]+=\"?[^\" \t\r>]*\"?} $pos} res1] ||
  194.     [lindex $res1 1] < $pos ||
  195.     ![regexp {([^=]+=)((\"[^\" \t\r]*\")|([^\" \t\r>]*))} [eval getText $res1] tmp attr choice]} {
  196.         beep
  197.         message "Current position is not at an attribute with choices."
  198.         return
  199.     }
  200.     set pos0 [expr [lindex $res1 0] + [string length $attr]]
  201.     set pos1 [expr $pos0 + [string length $choice]]
  202.     set choice [string trim $choice \"]
  203.     set tag [string toupper $tag]
  204.     if {$tag == "INPUT"} {
  205.         if {![regexp -nocase {type=(([^\" \t\r>]+)|(\"[^\" \t\r]+\"))} [eval getText $res] tmp tag]} {
  206.             beep
  207.             message "Current position is not at an attribute with choices."
  208.             return
  209.         }
  210.         set tag [string trim [string toupper $tag] \"]
  211.     }
  212.     if {$tag == "LI"} {
  213.         set ltype [htmlFindList]
  214.         if {$ltype == "UL"} {
  215.             set tag "LI IN UL"
  216.         } elseif {$ltype == "OL"} {
  217.             set tag "LI IN OL"
  218.         }            
  219.     }
  220.     set attr [string trim [string toupper $attr]]
  221.     if {($tag != "OL" && $tag != "LI IN OL") || $attr != "TYPE="} {set choice [string toupper $choice]}
  222.     set choices [htmlGetChoices $tag]
  223.     foreach c $choices {
  224.         if {[string match "${attr}*" $c]} {
  225.             lappend matches [string range $c [string length $attr] end]
  226.         }    
  227.     }
  228.     if {![info exists matches]} {
  229.         beep
  230.         message "Current position is not at an attribute with choices."
  231.         return
  232.     }
  233.     if {[set this [lsearch -exact $matches $choice]] < 0} {set this 0}
  234.     incr this
  235.     if {$this == [llength $matches]} {set this 0}
  236.     set this [lindex $matches $this]
  237.     if {($tag != "OL" && $tag != "LI IN OL") || $attr != "TYPE="} {set this [htmlSetCase $this]}
  238.     replaceText $pos0 $pos1 "\"$this\""
  239.     goto [expr ($pos0 + [string length $this] > $pos) ? $pos + 1 : $pos0 + [string length $this] + 1]
  240. }
  241.  
  242.  
  243. # Save current window and uploads it to the ftp server.
  244. proc htmlSavetoFTPServer {} {
  245.     global htmlPasswords HTMLmodeVars ftpSig
  246.  
  247.     set win [stripNameCount [lindex [winNames -f] 0]]
  248.     if {[set this [htmlThisFilePath 4]] == ""} {return}
  249.     set home [lindex $this 3]
  250.     if {$home == "" && [lindex $this 0] != "file:///"} {set home [htmlInWhichHomePage "[lindex $this 0][lindex $this 1]"]}
  251.     if {$home == "" || [lindex $this 4] == "4"} {
  252.         alertnote "Current window is not in a home page folder."
  253.         return
  254.     }
  255.     
  256.     foreach f $HTMLmodeVars(FTPservers) {
  257.         if {[lindex $f 0] == $home} {set serv $f}
  258.     }
  259.     if {![info exists serv]} {
  260.         alertnote "No ftp server specified for this home page."
  261.         htmlHomePages "[lindex $this 0][lindex $this 1]"
  262.         return
  263.     }
  264.     
  265.     if {[lindex $serv 3] != ""} {set htmlPasswords($home) [lindex $serv 3]}
  266.     if {![info exists htmlPasswords($home)]} {
  267.         if {![catch {htmlGetPassword [lindex $serv 1]} pword]} {
  268.             set htmlPasswords($home) $pword
  269.         } else {
  270.             return
  271.         }
  272.     }
  273.     save
  274.     set path [lindex $this 2]
  275.     if {[lindex $serv 4] != ""} {set path [join [list [lindex $serv 4] $path] /]}
  276.     if {![info exists ftpSig] || ![app::isRunning $ftpSig] && [catch {app::launchBack $ftpSig}]} {
  277.         getApplSig "Please locate your ftp application" ftpSig
  278.         app::launchBack $ftpSig
  279.     }
  280.     currentReplyHandler htmlHandleReply
  281.     switch $ftpSig {
  282.         Arch -
  283.         FTCh {AEBuild -r -q -t 30000 '$ftpSig' Arch Stor ---- [makeAlis $win] FTPh "“[lindex $serv 1]”" FTPc "“$path”" ArGU "“[lindex $serv 2]”" ArGp "“$htmlPasswords($home)”"}
  284.         Woof {
  285.             set path [string range $path 0 [expr [string last / $path] - 1]]
  286.             AEBuild -r -q -t 30000 '$ftpSig' PURL PURL ---- [makeAlis $win] dest "“ftp://[lindex $serv 2]:$htmlPasswords($home)@[lindex $serv 1]/$path”"
  287.         }
  288.     }
  289. }
  290.  
  291. proc htmlHandleReply {reply} {
  292.     global htmlPasswords
  293.     set ans [string range $reply 11 end]
  294.     if {[regexp {^errs:“([^”]+)”} $ans dum err]} {
  295.         # Fetch error
  296.         if {[regexp {Error: (.*)} $err dum err2]} {set err $err2}
  297.         alertnote "Ftp error: $err"
  298.         unset htmlPasswords
  299.     } elseif {[regexp {^'----':(-?[0-9]*)} $ans dum err]} {
  300.         if {$err != "0"} {
  301.             # Anarchie error.
  302.             message "Ftp error."
  303.             unset htmlPasswords
  304.         } else {
  305.             message "Document uploaded to ftp server."
  306.         }
  307.     } elseif {$ans == "\\\}"} {
  308.         message "Document uploaded to ftp server."
  309.     } else {
  310.         return 0
  311.     }
  312.     return 1
  313. }
  314.  
  315.  
  316. proc htmlGetPassword {host} {
  317.     set values [dialog -w 300 -h 90 -t "Password for $host:" 10 20 290 30 \
  318.         -e "" 10 40 290 42 -b OK 20 60 85 80 -b Cancel 105 60 170 80]
  319.     if {[lindex $values 2]} {error "Cancel"}
  320.     return [string trim [lindex $values 0]]
  321. }
  322.  
  323. proc htmlForgetPasswords {} {
  324.     global htmlPasswords
  325.     message "Passwords forgotten."
  326.     unset htmlPasswords
  327. }
  328.  
  329. # Calculate the total size of a document including images etc.
  330. proc htmlDocumentSize {} {
  331.     # Get path to this window.
  332.     if {[set thisURL [htmlThisFilePath 3]] == ""} {return}
  333.     set exp1 "<!--|\[ \\t\\n\\r\]+(SRC=|LOWSRC=|DYNSRC=|BACKGROUND=)(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  334.     set exp2 {/\*|[ \t\r\n]+(url)\(\"?([^\"\)]+)\"?\)}
  335.     set commStart1 "<!--"
  336.     set commEnd1 "-->"
  337.     set commStart2 {/*}
  338.     set commEnd2 {*/}
  339.     set size 0
  340.     set counted {}
  341.     set external 0
  342.     set notfound 0
  343.     for {set i 1} {$i < 3} {incr i} {
  344.         set pos 0
  345.         set exp [set exp$i]
  346.         set commStart [set commStart$i]
  347.         set commEnd [set commEnd$i]
  348.         while {![catch {search -s -f 1 -i 1 -m 0 -r 1 $exp $pos} res]} {
  349.             set restxt [eval getText $res]
  350.             # Comment?
  351.             if {$restxt == $commStart} {
  352.                 if {![catch {search -s -f 1 -m 0 -i 0 -r 0 -- $commEnd [lindex $res 1]} res]} {
  353.                     set pos [lindex $res 1]
  354.                     continue
  355.                 } else {
  356.                     break
  357.                 }
  358.             }
  359.             # Get path to link.
  360.             regexp -nocase $exp $restxt dum1 dum2 linkTo
  361.             set linkTo [htmlURLunEscape [string trim $linkTo \"]]
  362.             if {![catch {lindex [htmlPathToFile [lindex $thisURL 0] [lindex $thisURL 1] [lindex $thisURL 2] [lindex $thisURL 3] $linkTo] 0} linkToPath]} {
  363.                 if {[file exists $linkToPath] && ![file isdirectory $linkToPath]} {
  364.                     if {[lsearch -exact $counted $linkToPath] < 0} {
  365.                         getFileInfo $linkToPath arr
  366.                         incr size $arr(datalen)
  367.                         lappend counted $linkToPath
  368.                     }
  369.                 } else {
  370.                     set notfound 1
  371.                 }
  372.             } else {
  373.                 set external 1
  374.             }
  375.             set pos [lindex $res 1]
  376.         }
  377.     }
  378.     incr size [maxPos]
  379.     if {$size > 1000} {
  380.         set size "[expr $size /1024] kB"
  381.     } else {
  382.         append size " bytes"
  383.     }
  384.     set txt "Total size: $size."
  385.     if {$notfound} {append etxt "Some files not found. "}
  386.     if {$external} {append etxt "External sources excluded."}
  387.     if {$notfound || $external} {append txt " ([string trim $etxt])"}
  388.     alertnote $txt
  389. }
  390.  
  391. #
  392. # dividing line
  393. #
  394. proc htmlCommentLine {} {
  395.     global HTMLmodeVars fillColumn
  396.     set wordWrap    $HTMLmodeVars(wordWrap)
  397.     set comStr    [htmlCommentStrings]
  398.     set prefixString [lindex $comStr 0]
  399.     set suffixString [lindex $comStr 1]
  400.     set s "===================================================================================="
  401.     set l [expr [string length $prefixString] + [string length $suffixString]]
  402.     if {$wordWrap} { 
  403.         set l [expr $fillColumn - $l - 1] 
  404.     } else {
  405.         set l [expr 75 - $l - 1]
  406.     }
  407.     insertText [htmlOpenCR [htmlFindNextIndent]] $prefixString [string range $s 0 $l] $suffixString "\r"
  408. }
  409.  
  410.  
  411. #===============================================================================
  412. # Character translation
  413. #===============================================================================
  414.  
  415. #
  416. # Converting  characters to HTML entities.
  417. #
  418. # 1 = < > &
  419. # 0 = áé etc.
  420. proc htmlCharacterstohtml {ltgtamp} {
  421.     global htmlSpecialCharacter 
  422.     global htmlSpecialCapCharacter htmlSpecialSymbCharacter
  423.     
  424.     if {$ltgtamp} {
  425.         set charlist {& < >}
  426.     } else {    
  427.         foreach a [array names htmlSpecialCharacter] {
  428.             if { $a != "eth" && $a != "thorn" && $a != "y´"} { 
  429.                 lappend charlist $a
  430.             }
  431.         }
  432.         
  433.         foreach a [array names htmlSpecialCapCharacter] {
  434.             if {$a != "ETH" && $a != "THORN" && $a != "Y´"} { 
  435.                 lappend charlist $a
  436.             }
  437.         }
  438.         lappend charlist ¡ ¿
  439.     }
  440.     
  441.     set subs1 0;  set lett 0
  442.     set pos [getPos]
  443.     if {[set start $pos] == [set end [selEnd]]} {
  444.         if {$ltgtamp && \
  445.         [askyesno "There is no selection. Really translate < > & in whole document?"] == "no"} {return}
  446.         set messageString "document"
  447.         set start 0
  448.         set end [maxPos]
  449.         set isDoc 1
  450.     } else {
  451.         set messageString "selection"
  452.         set isDoc 0
  453.     }
  454.     message "Translating…"
  455.     set text [getText $start $end]
  456.     set tmp $text
  457.     set upos $pos
  458.     set st $start
  459.     if {!$ltgtamp} {
  460.         while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $tmp str]} {
  461.             set sv [string range $tmp [lindex $str 0] [lindex $str 1]]
  462.             if {[expr $st + [lindex $str 1]] < $upos} {
  463.                 incr pos [expr 17 - [string length $sv]]
  464.             } elseif {[expr $st + [lindex $str 0]] < $upos} {
  465.                 incr pos [expr $st + [lindex $str 0] - $upos]
  466.             }
  467.             lappend savestr $sv
  468.             set tmp [string range $tmp [lindex $str 1] end]
  469.             incr st [lindex $str 1]
  470.         }
  471.         regsub -all -nocase "<!--\[ \t\r\]+#(INCLUDE|LASTMODIFIED)\[ \t\r\]+\[^>\]+>" $text {<!-- #INCLUDE -->} text
  472.     }
  473.     if {$isDoc} {    
  474.         set text1 [string range $text 0 [expr $pos - $start - 1]]
  475.         set text2 [string range $text [expr $pos - $start] end]
  476.     } else {
  477.         set text1 $text
  478.     }
  479.     foreach char $charlist {
  480.  
  481.         if {[info exists htmlSpecialCharacter($char)]} {
  482.             set rtext "\\&$htmlSpecialCharacter($char);"
  483.         } elseif {[info exists htmlSpecialCapCharacter($char)]} {
  484.             set rtext "\\&$htmlSpecialCapCharacter($char);"
  485.         } elseif {[info exists htmlSpecialSymbCharacter($char)]} {
  486.             set rtext "\\&$htmlSpecialSymbCharacter($char);"
  487.         } elseif {$char == ">"} {
  488.             set rtext "\\>" 
  489.         } elseif {$char == "<"} {
  490.             set rtext "\\<"
  491.         } elseif {$char == "&"} {
  492.             set rtext "\\&"
  493.         }
  494.         
  495.         set subNum [regsub -all $char $text1 [set rtext] text1]
  496.         incr subs1 [expr $subNum * ([string length $rtext] - 2)]
  497.         incr lett $subNum
  498.         if {$isDoc} {
  499.             incr lett [regsub -all $char $text2 [set rtext] text2]
  500.         }
  501.         
  502.     }
  503.     set text $text1
  504.     if {$isDoc} {append text $text2}
  505.     if {$lett} {
  506.         if {[info exists savestr]} {
  507.             set i 0
  508.             set tmp ""
  509.             while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $text str]} {
  510.                 append tmp [string range $text 0 [expr [lindex $str 0] - 1]]
  511.                 append tmp [lindex $savestr $i]
  512.                 set text [string range $text [expr [lindex $str 1] + 1] end]
  513.                 incr i
  514.             }
  515.             set text "$tmp$text"
  516.         }
  517.         replaceText $start $end $text
  518.         if {$isDoc} {
  519.             goto [expr $upos + $subs1]
  520.         } else {
  521.             set end [getPos]
  522.             select $start $end
  523.         }
  524.     }
  525.     message "$lett characters translated in $messageString."
  526. }
  527.  
  528.  
  529.  
  530. #
  531. # Converting HTML entities to characters.
  532. #
  533. # 1 = < > &
  534. # 0 = áé etc.
  535. proc htmltoCharacters {ltgtamp} {
  536.     global htmlCharacterSpecial  
  537.     global htmlCapCharacterSpecial 
  538.     
  539.     message "Translating…"
  540.     
  541.     if {$ltgtamp} {
  542.         set entitylist {"&" "<" ">"} 
  543.     } else {
  544.         foreach a [array names htmlCharacterSpecial] {
  545.             if { $a != "eth" && $a != "thorn" && $a != "y´"} { 
  546.                 lappend entitylist "&$a;"
  547.             }
  548.         }
  549.         
  550.         foreach a [array names htmlCapCharacterSpecial] {
  551.             if {$a != "ETH" && $a != "THORN" && $a != "Y´"} { 
  552.                 lappend entitylist "&$a;"
  553.             }
  554.         }
  555.         # ¡ ¿
  556.         lappend entitylist "¡" "¿"
  557.     }
  558.     set subs1 0;  set lett 0
  559.     set pos [getPos]
  560.     if {[set start $pos] == [set end [selEnd]]} {
  561.         # Move position to linestart to make sure no letter is split.
  562.         set pos [lineStart $pos]
  563.         set messageString "document"
  564.         set start 0
  565.         set end [maxPos]
  566.         set isDoc 1
  567.     } else {
  568.         set messageString "selection"
  569.         set isDoc 0
  570.     }
  571.  
  572.     set text [getText $start $end]
  573.     set tmp $text
  574.     set upos $pos
  575.     set st $start
  576.     if {!$ltgtamp} {
  577.         while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $tmp str]} {
  578.             set sv [string range $tmp [lindex $str 0] [lindex $str 1]]
  579.             if {[expr $st + [lindex $str 1]] < $upos} {
  580.                 incr pos [expr 17 - [string length $sv]]
  581.             } elseif {[expr $st + [lindex $str 0]] < $upos} {
  582.                 incr pos [expr $st + [lindex $str 0] - $upos]
  583.             }
  584.             lappend savestr $sv
  585.             set tmp [string range $tmp [lindex $str 1] end]
  586.             incr st [lindex $str 1]
  587.         }
  588.         regsub -all -nocase "<!--\[ \t\r\]+#(INCLUDE|LASTMODIFIED)\[ \t\r\]+\[^>\]+>" $text {<!-- #INCLUDE -->} text
  589.     }
  590.     if {$isDoc} {
  591.         set text1 [string range $text 0 [expr $pos - $start - 1]]
  592.         set text2 [string range $text [expr $pos - $start] end]
  593.     } else {
  594.         set text1 $text
  595.     }        
  596.     foreach char $entitylist {
  597.         set schar [string range $char 1 [expr [string length $char] - 2]]
  598.         if {[info exists htmlCharacterSpecial($schar)]} {
  599.             set rtext "$htmlCharacterSpecial($schar)"
  600.         } elseif {[info exists htmlCapCharacterSpecial($schar)]} {
  601.             set rtext "$htmlCapCharacterSpecial($schar)"
  602.         } elseif {$schar == "#161"} {
  603.             set rtext ¡
  604.         } elseif {$schar == "#191"} {
  605.             set rtext ¿
  606.         } elseif {$schar == "amp"} {
  607.             set rtext "\\&"
  608.         } elseif {$schar == "lt"} {
  609.             set rtext "<"
  610.         } elseif {$schar == "gt"} {
  611.             set rtext ">"
  612.         }
  613.         
  614.         set subNum [regsub -all $char $text1 $rtext text1]
  615.         incr subs1 [expr $subNum * ([string length $char] - 1)]
  616.         incr lett $subNum
  617.         if {$isDoc} {
  618.             incr lett [regsub -all $char $text2 $rtext text2]
  619.         }
  620.         
  621.     }
  622.     set text $text1
  623.     if {$isDoc} {append text $text2}
  624.     if {$lett} {
  625.         if {[info exists savestr]} {
  626.             set i 0
  627.             set tmp ""
  628.             while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $text str]} {
  629.                 append tmp [string range $text 0 [expr [lindex $str 0] - 1]]
  630.                 append tmp [lindex $savestr $i]
  631.                 set text [string range $text [expr [lindex $str 1] + 1] end]
  632.                 incr i
  633.             }
  634.             set text "$tmp$text"
  635.         }
  636.         replaceText $start $end $text
  637.         if {$isDoc} {
  638.             goto [expr $upos - $subs1]
  639.         } else {
  640.             set end [getPos]
  641.             select $start $end
  642.         }
  643.     }
  644.     message "$lett characters translated in $messageString."
  645. }
  646.  
  647.  
  648. #===============================================================================
  649. # General Commands
  650. #===============================================================================
  651.  
  652. # remove containing tags
  653. proc htmlUntagandSelect {} {htmlUntag 1}
  654.  
  655. proc htmlUntag {{selectit 0}} {
  656.     set curPos [getPos]
  657.     set tags [htmlGetContainer $curPos [selEnd]]
  658.     if {[llength $tags] < 5} {
  659.         alertnote "Cannot decide on enclosing tags."
  660.         return
  661.     }
  662.     # delete them
  663.     replaceText [lindex $tags 0] [lindex $tags 3] \
  664.     [getText [lindex $tags 1] [lindex $tags 2]]
  665.     if {$selectit} {
  666.         select [lindex $tags 0] \
  667.             [expr [lindex $tags 2] - [lindex $tags 1] + [lindex $tags 0]]
  668.     } else {
  669.         if {$curPos < [lindex $tags 1]} {set curPos [lindex $tags 1]}
  670.         if {$curPos > [lindex $tags 2]} {set curPos [lindex $tags 2]}
  671.         goto [expr $curPos - [lindex $tags 1] + [lindex $tags 0]]
  672.     }
  673.     message "[lindex $tags 4] deleted."
  674. }
  675.  
  676. # select container, like Balance (cmd-B)
  677. proc htmlSelectinContainer {} {htmlSelectContainer 1}
  678.  
  679. proc htmlSelectContainer {{inside 0}} {
  680.     set start [getPos]
  681.     if {$start != 0 &&
  682.             ![catch {getText $start [expr $start + 2]} lookingAt] &&
  683.             $lookingAt != "</" &&
  684.             [string range $lookingAt 0 0] == "<"} {
  685.         incr start -1
  686.     }
  687.     set tags [htmlGetContainer $start [selEnd]]
  688.     if {[llength $tags] == 5} {
  689.         if {$inside} {
  690.             select [lindex $tags 1] [lindex $tags 2]
  691.         } else {
  692.             select [lindex $tags 0] [lindex $tags 3]
  693.         }
  694.         message "[lindex $tags 4] selected."
  695.     } else {
  696.         beep
  697.         message "Cannot decide on enclosing tags."
  698.     }
  699. }
  700.  
  701. # Select an opening tag, or remove it, of an element without a closing tag.
  702. proc htmlRemoveOpening {} {htmlSelectOpening 1}
  703.  
  704. proc htmlSelectOpening {{remove 0}} {
  705.     set begin [getPos]
  706.     # back up one if possible and selection is wanted.
  707.     if {$begin >0 && !$remove} {incr begin -1}
  708.     set tag [htmlGetOpening $begin]
  709.     if {[llength $tag] == 3} {
  710.         if {$remove} {
  711.             deleteText [lindex $tag 0] [lindex $tag 1]
  712.             if {$begin < [lindex $tag 1]} {set begin [lindex $tag 1]}
  713.             goto [expr $begin - [lindex $tag 1] + [lindex $tag 0]]
  714.             message "[lindex $tag 2] deleted."
  715.         } else {
  716.             select [lindex $tag 0] [lindex $tag 1]
  717.             message "[lindex $tag 2] selected."
  718.         }
  719.     } else {
  720.         if {$remove} {
  721.             alertnote "Cannot find opening tag."
  722.         } else {
  723.             beep
  724.             message "Cannot find opening tag."
  725.         }
  726.     }
  727. }
  728.  
  729. # Called by cmd-double-click.
  730. # Change attributes if click on a tag.
  731. proc htmlChangeDblClick {} {
  732.     set pos [getPos]
  733.     if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $pos} res] ||
  734.     [lindex $res 1] < $pos} {return}
  735.     set txt [getText [expr [lindex $res 0] + 1] [expr [lindex $res 1] - 1]]
  736.     if {[string index [set tag [lindex $txt 0]] 0] == "/" || $tag == "!--"} {return}
  737.     if {[set newTag [htmlChangeElement $txt [string toupper $tag] [lindex $res 0]]] != ""} {
  738.         replaceText [lindex $res 0] [lindex $res 1] $newTag
  739.     }
  740. }
  741.  
  742. # Change an existing element.
  743. proc htmlChangeContainer {} {
  744.     set tag [htmlGetContainer [getPos] [selEnd]]
  745.     if {[llength $tag] == 5} {
  746.         set newTag [htmlChangeElement [getText [expr [lindex $tag 0] + 1] \
  747.         [expr [lindex $tag 1] - 1]] [lindex $tag 4] [lindex $tag 0]]
  748.         if {[string length $newTag]} {
  749.             replaceText [lindex $tag 0] [lindex $tag 1] $newTag
  750.         }
  751.     } else {
  752.         alertnote "Cannot decide on enclosing tags."
  753.     }
  754. }
  755.  
  756. proc htmlChangeOpening {} {
  757.     set tag [htmlGetOpening [getPos]]
  758.     if {[llength $tag] == 3} {
  759.         set newTag [htmlChangeElement [getText [expr [lindex $tag 0] + 1] \
  760.         [expr [lindex $tag 1] - 1]] [lindex $tag 2] [lindex $tag 0]]
  761.         if {[string length $newTag]} {
  762.             replaceText [lindex $tag 0] [lindex $tag 1] $newTag
  763.         }
  764.     } else {
  765.         alertnote "Cannot find opening tag."
  766.     }
  767. }
  768.  
  769. #
  770. # Exstracts all attributes to a element from a list, and puts up a dialog window
  771. # where the user can change the attributes.
  772. #
  773. proc htmlChangeElement {tag elem {wrPos 0}} {
  774.     global htmlColorAttr htmlURLAttr HTMLmodeVars
  775.     global htmluserColorname htmlColorNumber
  776.     global htmlElemAttrOptional1 htmlElemKeyBinding
  777.     global htmlElemEventHandler1 htmlWindowAttr htmlPlugins
  778.     global htmlSpecURL htmlSpecColor htmlSpecWindow
  779.  
  780.     # Remove tabs and returns from list.
  781.     regsub -all "\[\t\r\]+" $tag " " tag
  782.     
  783.     # Remove element name.
  784.     set tagelem [lindex $tag 0]
  785.     set tag [string range $tag [string length $tagelem] end]
  786.     set attrs ""
  787.     set attrVals ""
  788.     
  789.     # Exstract the attributes.
  790.     while {[regexp {[ ]+([^ "]+"[^"]*"|[^ "]+)} $tag thisatt]} {
  791.         set tag [string range $tag [string length $thisatt] end]
  792.         set thisatt [htmlRemoveQuotes $thisatt]
  793.         lappend attrs [string toupper [string trim [lindex $thisatt 0]]]
  794.         lappend attrVals [lindex $thisatt 1]
  795.     }    
  796.     
  797.     # All INPUT elements are defined differently. Must extract TYPE.
  798.     if {$elem == "INPUT"} {
  799.         set typeIndex [lsearch -exact [string toupper $attrs] "TYPE="]
  800.         if {$typeIndex >= 0 } {
  801.             set elem [string toupper [lindex $attrVals $typeIndex]]
  802.             set used "INPUT TYPE=\"${elem}\""
  803.             if {![info exists htmlElemKeyBinding($elem)]} {set elem "INPUT TYPE=$elem"}
  804.             # Remove TYPE attribute from list.
  805.             set attrs [lreplace $attrs $typeIndex $typeIndex]
  806.             set attrVals [lreplace $attrVals $typeIndex $typeIndex]
  807.         } else {
  808.             beep 
  809.             message "INPUT element without a TYPE attribute."
  810.             return
  811.         } 
  812.     } else {
  813.         set used $elem
  814.     }
  815.     
  816.     # If EMBED element, choose which
  817.     if {$elem == "EMBED"} {
  818.         if {[catch {listpick -p "Which plug-in?" [lsort $htmlPlugins]} elem] || ![string length $elem]} {return}
  819.     }
  820.     
  821.     # If LI element, check in which list.
  822.     if {$elem == "LI"} {
  823.         set ltype [htmlFindList]
  824.         if {$ltype == "UL"} {
  825.             set elem "LI IN UL"
  826.         } elseif {$ltype == "OL"} {
  827.             set elem "LI IN OL"
  828.         }            
  829.     }
  830.             
  831.     # Element known by HTML mode?
  832.     if {![info exists htmlElemAttrOptional1($elem)]} {
  833.         alertnote "Unknown element: $elem"
  834.         return
  835.     }
  836.     
  837.     set useBig $HTMLmodeVars(changeInBigWindows)
  838.     set optatts [htmlGetOptional $elem]
  839.     set optattsUp [string toupper $optatts]
  840.     set alloptatts [htmlGetOptional $elem 1]
  841.     set alloptattsUp [string toupper $alloptatts]
  842.     set reqatts [htmlGetRequired $elem]
  843.     set allAttrs [htmlGetUsed $elem $reqatts $optatts]
  844.     set reallyAllAtts [string toupper [concat $reqatts $alloptatts]]
  845.     
  846.     set choices [htmlGetChoices $elem]
  847.     set numAttrs [htmlGetNumber $elem]
  848.     
  849.     set errText ""
  850.     
  851.     # First check if one which is normally not used is used.
  852.     set addNotUsed 0
  853.     set toup [string toupper $allAttrs]
  854.     foreach a $attrs {
  855.         if {[lsearch -exact $toup $a] < 0 && [lsearch -exact $reallyAllAtts $a] >= 0} {
  856.             regsub -all "\[ \n\r\t]+([join $allAttrs |])" " $optatts" " " notUsedAtts
  857.             append allAttrs " $notUsedAtts"
  858.             set addNotUsed 1
  859.             break
  860.         }
  861.     }
  862.     
  863.     # then check some hidden one is used
  864.     set addHidden 0
  865.     set toup [string toupper $allAttrs]
  866.     foreach a $attrs {
  867.         if {[lsearch -exact $toup $a] < 0 && [lsearch -exact $reallyAllAtts $a] >= 0} {
  868.             regsub -all "\[ \n\r\t]+([join $optatts |])" " $alloptatts" " " hiddenAtts
  869.             append allAttrs " $hiddenAtts"
  870.             set addNotUsed 1
  871.             set addHidden 1
  872.             break
  873.         }
  874.     }
  875.     # finally check if some is unknown
  876.     set toup [string toupper $allAttrs]
  877.     foreach a $attrs {
  878.         if {[lsearch -exact $toup $a] < 0} {
  879.             lappend errText "Unknown attribute: $a"
  880.         }
  881.     }
  882.     
  883.     # Add something if all attrs are hidden.
  884.     if {![llength $allAttrs]} {
  885.         set allAttrs $optatts
  886.         set addNotUsed 1
  887.     } 
  888.     
  889.     # Does this element have any attributes?
  890.     if {![llength $allAttrs]} {
  891.         if {[llength $errText]} {
  892.             if {[askyesno "$elem has no attributes. Remove the ones in the text?"] == "no"} {
  893.                 return
  894.             } else {
  895.                 return [htmlSetCase <$elem>]
  896.             }
  897.         } else {
  898.             beep
  899.             message "$elem has no attributes."
  900.             return
  901.         }
  902.     }
  903.     
  904.     set values ""
  905.     # Add two dummy elements for OK and Cancel buttons.
  906.     if {$useBig} {set values {0 0}}
  907.     set allAttrs [string toupper $allAttrs]
  908.     # Build a list with attribute vales.
  909.     foreach a $allAttrs {
  910.         set attrIndex [lsearch -exact $attrs $a]
  911.         if {$attrIndex >= 0 } {set aval [lindex $attrVals $attrIndex]}
  912.         set a2 [string trimright $a =]
  913.         if {[string index $a [expr [string length $a] - 1]] != "="} {
  914.             # Flag
  915.             if {$attrIndex >= 0} {
  916.                 lappend values 1
  917.             } else {
  918.                 lappend values 0
  919.             } 
  920.         } elseif {([lsearch -exact $htmlURLAttr $a] >= 0 && [lsearch -exact $htmlSpecURL "${elem}!=$a2"] < 0) || \
  921.             [lsearch -exact $htmlSpecURL "${elem}=$a2"] >= 0} {
  922.                 # URL
  923.             if {$attrIndex >= 0} {
  924.                 set aval [htmlURLunEscape $aval]
  925.                 htmlAddToCache URLs $aval
  926.                 if {$useBig} {
  927.                     lappend values "" $aval 0
  928.                 } else {
  929.                     lappend values $aval
  930.                 }
  931.             } else {
  932.                 if {$useBig} {
  933.                     lappend values "" "No value" 0
  934.                 } else {
  935.                     lappend values ""
  936.                 }
  937.             }
  938.         } elseif {([lsearch -exact $htmlColorAttr $a] >= 0 && [lsearch -exact $htmlSpecColor "${elem}!=$a2"] < 0) || \
  939.         [lsearch -exact $htmlSpecColor "${elem}=$a2"] >= 0} {
  940.             # Color
  941.             if {$attrIndex >= 0} {
  942.                 set aval [htmlCheckColorNumber $aval]
  943.                 if {$aval == 0} {
  944.                     lappend errText "$a: Invalid color number."
  945.                     if {$useBig} {
  946.                         lappend values "" "No value" 0
  947.                     } else {
  948.                         lappend values ""
  949.                     }
  950.                 } elseif {[info exists htmluserColorname($aval)]} {
  951.                     if {$useBig} {
  952.                         lappend values "" $htmluserColorname($aval) 0
  953.                     } else {
  954.                         lappend values $htmluserColorname($aval)
  955.                     }
  956.                 } elseif {[info exists htmlColorNumber($aval)]} {
  957.                     if {$useBig} {
  958.                         lappend values "" $htmlColorNumber($aval) 0
  959.                     } else {
  960.                         lappend values $htmlColorNumber($aval)
  961.                     }
  962.                 } else {
  963.                     if {$useBig} {
  964.                         lappend values $aval "No value" 0
  965.                     } else {
  966.                         lappend values $aval
  967.                     }
  968.                 }
  969.             } else {
  970.                 if {$useBig} {
  971.                     lappend values "" "No value" 0
  972.                 } else {
  973.                     lappend values ""
  974.                 }
  975.             }
  976.         } elseif {([lsearch -exact $htmlWindowAttr $a] >= 0 && [lsearch -exact $htmlSpecWindow "${elem}!=$a2"] < 0) || \
  977.         [lsearch -exact $htmlSpecWindow "${elem}=$a2"] >= 0} {
  978.             # Window
  979.             if {$attrIndex >= 0} {
  980.                 htmlAddToCache windows $aval
  981.                 if {$useBig} {
  982.                     lappend values "" $aval
  983.                 } else {
  984.                     lappend values $aval
  985.                 }
  986.             } else {
  987.                 if {$useBig} {
  988.                     lappend values "" "No value"
  989.                 } else {
  990.                     lappend values ""
  991.                 }
  992.             }
  993.         } elseif {[lsearch $numAttrs "${a}*"] >= 0} {
  994.             # Number
  995.             if {$attrIndex >= 0} {
  996.                 set numcheck [htmlCheckAttrNumber $elem $a $aval]
  997.                 if {$numcheck == 1} {
  998.                     lappend values $aval
  999.                 } else {
  1000.                     lappend errText "$a: $numcheck"
  1001.                     lappend values ""
  1002.                 }
  1003.             } else {
  1004.                 lappend values ""
  1005.             }
  1006.         } elseif {[lsearch $choices "${a}*"] >= 0} {
  1007.             # Choices
  1008.             if {$attrIndex >= 0} {
  1009.                 set match ""
  1010.                 if {!(($elem == "OL" || $elem == "LI IN OL") && $a == "TYPE=")} {
  1011.                     set aval [string toupper $aval]
  1012.                 }
  1013.                 foreach w $choices {
  1014.                     if {$w == "${a}${aval}"} {
  1015.                         set match $aval
  1016.                     }
  1017.                 }
  1018.                 if {[string length $match]} {
  1019.                     lappend values $match
  1020.                 } else {
  1021.                     lappend errText "$a: Unknown choice, $aval."
  1022.                     lappend values ""
  1023.                 }
  1024.             } else {
  1025.                 lappend values ""
  1026.             }    
  1027.         } elseif {$attrIndex >= 0} {
  1028.             # Any other
  1029.             lappend values $aval
  1030.         } else {
  1031.             lappend values ""
  1032.         }
  1033.     }
  1034.     # If invalid attributes, continue?
  1035.     if {[llength $errText] && ![htmlErrorWindow "$elem not well-defined" $errText 1]} {
  1036.         return 
  1037.     }
  1038.     if {$useBig} {
  1039.         set r [htmlOpenElemWindow $used $elem [posX $wrPos] $values $addNotUsed $addHidden $wrPos]
  1040.     } else {
  1041.         set r [htmlOpenElemStatusBar $used $elem [posX $wrPos] $values $addNotUsed $addHidden $wrPos]
  1042.     }
  1043.     return $r
  1044. }
  1045.  
  1046. # Removes all tags in a selection or the whole document.
  1047. proc htmlRemoveTags {} {
  1048.     if {![isSelection]} {
  1049.         if {[set ync [askyesno -c "Put text without tags in a new window?"]] == "cancel"} {return}
  1050.         set txt [htmlTagStrip [getText 0 [maxPos]]]
  1051.         if {$ync == "yes"} {
  1052.             new
  1053.             insertText $txt
  1054.         } else {
  1055.             replaceText 0 [maxPos] $txt
  1056.         }
  1057.     } else {
  1058.         replaceText [getPos] [selEnd] [htmlTagStrip [getSelect]]
  1059.     }
  1060. }
  1061.  
  1062. # Put quotes around all attributes
  1063. proc htmlQuoteAllAttributes {} {
  1064.     htmlScanAllTags quote
  1065. }
  1066.  
  1067. proc htmlTagstoLowercase {} {
  1068.     htmlScanAllTags case tolower
  1069. }
  1070.  
  1071. proc htmlTagstoUppercase {} {
  1072.     htmlScanAllTags case toupper
  1073. }
  1074.  
  1075. proc htmlScanAllTags {doWhat {upperLower ""}} {
  1076.     set pos [getPos]
  1077.     if {[isSelection]} {
  1078.         set start [getPos]
  1079.         set end [selEnd]
  1080.     } else {
  1081.         set start 0
  1082.         set end [maxPos]
  1083.     }
  1084.     set text [getText $start $end]
  1085.     while {[regexp -indices {<!--|<[^<>]+>} $text tag]} {
  1086.         append newtext [string range $text 0 [lindex $tag 0]]
  1087.         set this [string range $text [expr [lindex $tag 0] + 1] [lindex $tag 1]]
  1088.         set text [string range $text [expr [lindex $tag 1] + 1] end]
  1089.         if {$this == "!--"} {
  1090.             if {[regexp -indices -- {-->} $text commend]} {
  1091.                 append newtext $this[string range $text 0 [lindex $commend 1]]
  1092.                 set text [string range $text [expr [lindex $commend 1] + 1] end]
  1093.             } else {
  1094.                 append newtext $text
  1095.                 set text ""
  1096.             }
  1097.         } else {
  1098.             if {$doWhat == "quote"} {
  1099.                 regsub -all "(\[ \t\r\]+\[^=\]+=)(\[^ >\"\t\r\]+)" $this {\1"\2"} newtag
  1100.             } else {
  1101.                 regsub -all "^\[^ \t\r>]+|\[ \t\r\]+\[^ \t\r=\]+=" $this "\[string $upperLower \"&\"\]" newtag
  1102.                 set newtag [subst $newtag]
  1103.             }
  1104.             append newtext $newtag
  1105.         }
  1106.     }
  1107.     append newtext $text
  1108.     replaceText $start $end $newtext
  1109.     goto $pos
  1110.     
  1111. }
  1112.  
  1113. # opens the manual in the browser.
  1114. proc htmlHelp {} {
  1115.     global HOME HTMLmodeVars modifiedModeVars browserSig
  1116.     switch $HTMLmodeVars(manualStartPage) {
  1117.         0 {set start HTMLmanual.html}
  1118.         1 {set start text:TableOfContents.html}
  1119.         2 {set start text:HTMLmanualFrames.html}
  1120.     }
  1121.     set path "$HTMLmodeVars(manualFolder):$start"
  1122.     if {![file exists $path]} {
  1123.         if {![catch {htmlGetDir "Locate manual"} folder]} {
  1124.             set path "$folder:$start"
  1125.             if {![file exists $path]} {
  1126.                 alertnote "Folder doesn't contain the HTML manual."
  1127.                 return
  1128.             }
  1129.             set HTMLmodeVars(manualFolder) $folder
  1130.             lappend modifiedModeVars {manualFolder HTMLmodeVars}
  1131.         } else {
  1132.             return
  1133.         }
  1134.     }
  1135.     htmlSendWindow $path
  1136.      if {!$HTMLmodeVars(browseInForeground)} { switchTo '$browserSig' }
  1137. }
  1138.  
  1139. #
  1140. # launch a viewer and pass this window to it
  1141. #
  1142. proc htmlSendWindow {{path ""}} {
  1143.     global HTMLmodeVars browserSig
  1144.  
  1145.     if {$path == ""} {
  1146.         set path [stripNameCount [lindex [winNames -f] 0]]
  1147.  
  1148.         if {[winDirty]} {
  1149.             if {$HTMLmodeVars(saveWithoutAsking) || [set ask [askyesno -c "Save '[file tail $path]'?"]] == "yes"} {
  1150.                 save
  1151.             } elseif {$ask == "cancel"} {
  1152.                 return
  1153.             } elseif {![file exists $path]} {
  1154.                 alertnote "Can't send window to browser."
  1155.                 return
  1156.             }
  1157.         }
  1158.         # Get path again, in case it was Untitled before.
  1159.         set path [stripNameCount [lindex [winNames -f] 0]]
  1160.     }
  1161.     if {![info exists browserSig] && [catch {getFileSig [icGetPref -t 1 Helper•http]} browserSig]} {set browserSig MOSS}
  1162.     if {![app::isRunning $browserSig] && [catch {app::launchBack $browserSig}]} {
  1163.         getApplSig "Please locate your web browser" browserSig
  1164.         app::launchBack $browserSig
  1165.     }
  1166.     
  1167.     # MSIE opens the file in a new window unless an open URL event is used.
  1168.     # Cyberdog opens the text file unless an open URL event is used.
  1169.     if {$browserSig == "MSIE" || $browserSig == "dogz"} {
  1170.         set path [htmlURLescape $path 1]
  1171.         regsub -all : $path / path
  1172.         set flgs ""
  1173.         if {$browserSig == "MSIE"} {set flgs "FLGS 1"}
  1174.         eval AEBuild '$browserSig' WWW! OURL "----" "“file:///$path”" $flgs
  1175.     } else {
  1176.         sendOpenEvent noReply '$browserSig' $path
  1177.     }
  1178.      if {$HTMLmodeVars(browseInForeground)} { switchTo '$browserSig' }
  1179. }
  1180.  
  1181. #===============================================================================
  1182. # Caches
  1183. #===============================================================================
  1184.  
  1185.  
  1186. proc htmlCleanUpCache {cache} {
  1187.     global HTMLmodeVars 
  1188.     global modifiedModeVars
  1189.     
  1190.     set URLs $HTMLmodeVars($cache)
  1191.  
  1192.     if {![llength $URLs]} {
  1193.         alertnote "No $cache are cached."
  1194.         return
  1195.     }
  1196.     set urlnumber [llength $URLs]
  1197.     set screenHeight [lindex [getMainDevice] 3]
  1198.     set maxLines [expr ($screenHeight - 160) / 20]
  1199.     set pages [expr ($urlnumber - 1) / $maxLines ]
  1200.     set thispage 0
  1201.     for {set i 0} {$i < $urlnumber} {incr i} {
  1202.         lappend URLsToSave 1
  1203.     }
  1204.     set thisbox $URLsToSave
  1205.     while {1} {
  1206.         if {$thispage < $pages} {
  1207.             set thisurlnumber $maxLines
  1208.         } else {
  1209.             set thisurlnumber [expr ($urlnumber - 1 ) % $maxLines + 1]
  1210.         }
  1211.         set height [expr 75 + $thisurlnumber  * 20]
  1212.         set box "-w 440 -h $height -b OK 20 [expr $height - 30]  85 [expr $height - 10] \
  1213.             -b Cancel 100 [expr $height - 30] 165 [expr $height - 10] \
  1214.             -b {Uncheck all} 180 [expr $height - 30] 265 [expr $height - 10] \
  1215.             -t {Uncheck the $cache you want to remove} 10 10 440 30 "
  1216.         if {$thispage < $pages} {
  1217.             lappend box -b "More…" 280 [expr $height - 30] 345 [expr $height - 10]
  1218.         }
  1219.         if {$thispage > 0} {
  1220.             lappend box -b "Back…" 360 [expr $height - 30] 425 [expr $height - 10]
  1221.         }
  1222.  
  1223.         set hpos 30 
  1224.         set thisURLs [lrange $URLs [expr $thispage * $maxLines] \
  1225.         [expr $thispage * $maxLines + $maxLines - 1]]
  1226.         set i 0
  1227.         foreach url $thisURLs {
  1228.             lappend box -c $url [lindex $thisbox $i] 10 $hpos 430 [expr $hpos + 15]
  1229.             incr i
  1230.             incr hpos 20
  1231.         }
  1232.         set thisbox [eval [concat dialog $box]]
  1233.         if {[lindex $thisbox 1]} {
  1234.             # cancel
  1235.             return
  1236.         } elseif {[lindex $thisbox 2]} {
  1237.             # uncheck all
  1238.             set thisbox {}
  1239.             for {set i 0} {$i < [llength $thisbox]} {incr i} {
  1240.                 lappend thisbox 0
  1241.             }
  1242.         } else {
  1243.             if {$pages == 0} {
  1244.                 set ll 3
  1245.             } elseif {$thispage == 0 || $thispage == $pages} {
  1246.                 set ll 4
  1247.             } else {
  1248.                 set ll 5
  1249.             }
  1250.             set URLsToSave [eval [concat lreplace [list $URLsToSave] [expr $thispage * $maxLines] \
  1251.             [expr $thispage * $maxLines + $maxLines - 1] [lrange $thisbox $ll end]]]
  1252.             if {[lindex $thisbox 0]} { 
  1253.                 # OK
  1254.                 break
  1255.             } elseif {$thispage < $pages && [lindex $thisbox 3]} { 
  1256.                 # more
  1257.                 incr thispage 1
  1258.                 set thisbox [lrange $URLsToSave [expr $thispage * $maxLines] \
  1259.                 [expr $thispage * $maxLines + $maxLines - 1]]
  1260.             } else {
  1261.                 # back
  1262.                 incr thispage -1
  1263.                 set thisbox [lrange $URLsToSave [expr $thispage * $maxLines] \
  1264.                 [expr $thispage * $maxLines + $maxLines - 1]]
  1265.             }
  1266.         }
  1267.     }
  1268.     set newurls {}
  1269.     for {set i 0} {$i < $urlnumber} {incr i} {
  1270.         if {[lindex $URLsToSave $i]} {
  1271.             lappend newurls [lindex $URLs $i]
  1272.         }
  1273.     }
  1274.     set HTMLmodeVars($cache) $newurls
  1275.     lappend modifiedModeVars [list $cache HTMLmodeVars]
  1276.     if {![llength $newurls]} {htmlEnable$cache off}
  1277. }
  1278.  
  1279. proc htmlSelScrapToURL {sel msg1 msg2} {
  1280.     set newurl [htmlURLunEscape [string trim [eval get$sel]]]
  1281.     # Convert tabs and returns.
  1282.     if {[regexp {[\t\r\n]} $newurl]} {
  1283.         alertnote "$msg1 contains tabs or returns. It will not be added to the URL cache."
  1284.         return
  1285.     }
  1286.     if {[string length $newurl]} {
  1287.         htmlAddToCache URLs $newurl
  1288.         message "$newurl added to URLs."
  1289.     } else {
  1290.         beep
  1291.         message $msg2
  1292.     }
  1293. }
  1294.  
  1295. proc htmlAddSelection {} {
  1296.     htmlSelScrapToURL Select Selection "No selection!"
  1297. }
  1298.  
  1299. proc htmlAddClipboard {} {
  1300.     htmlSelScrapToURL Scrap Clipboard "Clipboard empty!"
  1301. }
  1302.  
  1303. proc htmlClearCache {cache} {
  1304.     global HTMLmodeVars modifiedModeVars
  1305.     if {[askyesno "Remove all $cache from [string range $cache 0 [expr [string length $cache] - 2]] cache?"] == "yes"} {
  1306.         set HTMLmodeVars($cache) {}
  1307.         lappend modifiedModeVars [list $cache HTMLmodeVars]
  1308.         htmlEnable$cache off
  1309.     }
  1310. }
  1311.  
  1312. # Imports all URLs in a file to the cache.
  1313. proc htmlImport {} {
  1314.     global HTMLmodeVars modifiedModeVars htmlURLAttr
  1315.     set urls $HTMLmodeVars(URLs)
  1316.  
  1317.     if {[catch {getfile "Import URLs from:"} fil] || ![htmlIsTextFile $fil alertnote]} {return}
  1318.     set fid [open $fil r]
  1319.     set filecont " [read $fid]"
  1320.     close $fid
  1321.     if {[llength $urls]} {
  1322.         set cl [askyesno -c "Clear URL cache before importing?"]
  1323.         if {$cl == "cancel"} {
  1324.             return
  1325.         } elseif {$cl == "yes"} {
  1326.             set urls {}
  1327.         }
  1328.     }
  1329.             
  1330.     set exp1 "\[ \\t\\n\\r\]+("
  1331.     foreach attr $htmlURLAttr {
  1332.         append exp1 "$attr|"
  1333.     }
  1334.     set exp1 [string trimright $exp1 |]
  1335.     append exp1 ")(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  1336.     set exp2 {[ \t\r\n]+(url)\(\"?([^\"\)]+)\"?\)}
  1337.     for {set i1 1} {$i1 < 3} {incr i1} {
  1338.         set fcont $filecont
  1339.         set exp [set exp$i1]
  1340.         while {[regexp -nocase -indices $exp $fcont a b url]} {
  1341.             set link [htmlURLunEscape [string trim [string range $fcont [lindex $url 0] [lindex $url 1]] \"]]
  1342.             set fcont [string range $fcont [lindex $url 1] end]
  1343.             if {[lsearch -exact $urls $link] < 0} {
  1344.                 lappend urls  $link
  1345.             }
  1346.         }
  1347.     }
  1348.     set HTMLmodeVars(URLs) [lsort $urls]
  1349.     lappend modifiedModeVars {URLs HTMLmodeVars}
  1350.     htmlEnableURLs [expr ([llength $HTMLmodeVars(URLs)] > 0)]
  1351.     message "URLs imported."
  1352. }
  1353.  
  1354. # Export URLs in cache to a file.
  1355. proc htmlExport {} {
  1356.     global HTMLmodeVars
  1357.     if {![llength $HTMLmodeVars(URLs)]} {
  1358.         alertnote "URL cache is empty."
  1359.         return
  1360.     }
  1361.     foreach url $HTMLmodeVars(URLs) {
  1362.         lappend out "HREF=\"$url\""
  1363.     }
  1364.     if {![catch {putfile "Export URL cache to:" "URL cache"} fil]} {
  1365.         if {[file exists $fil]} {removeFile $fil}
  1366.         set fid [open $fil w]
  1367.         puts $fid [join $out "\n"]
  1368.         close $fid
  1369.         message "URLs exported."
  1370.     }
  1371. }
  1372.  
  1373. # Add all files in a folder to URL cache.
  1374. proc htmlAddFolder {} {
  1375.     global HTMLmodeVars modifiedModeVars
  1376.     if {[catch {htmlGetDir "Folder to cache:"} folder]} {return}
  1377.     set path ""
  1378.     foreach hp $HTMLmodeVars(homePages) {
  1379.         if {[string match "[lindex $hp 0]:*" "$folder:"]} {
  1380.             set path [string range $folder [expr [string length [lindex $hp 0]] +1] end]
  1381.             regsub -all {:} $path {/} path
  1382.             if {[string length $path]} {append path /}
  1383.         }
  1384.     }
  1385.     set val [dialog -w 350 -h 80 -t "Path:" 10 10 60 30 -e $path 70 10 340 25 \
  1386.     -b OK 20 50 85 70 -b Cancel 110 50 175 70]
  1387.     if {[lindex $val 2]} {return}
  1388.     set path [string trim [lindex $val 0]]
  1389.     if {[string length $path]} {set path "[string trimright $path /]/"}
  1390.     set urls $HTMLmodeVars(URLs)
  1391.     if {[llength $urls]} {
  1392.         set cl [askyesno -c "Clear URL cache first?"]
  1393.         if {$cl == "cancel"} {
  1394.             return
  1395.         } elseif {$cl == "yes"} {
  1396.             set urls {}
  1397.         }
  1398.     }
  1399.  
  1400.     foreach fil [glob -nocomplain "$folder:*"] {
  1401.         set name [file tail $fil]
  1402.         if {![file isdirectory $fil] && [lsearch -exact $urls "$path$name"] < 0} {
  1403.             lappend urls "$path$name"
  1404.         }
  1405.     }
  1406.     set HTMLmodeVars(URLs) [lsort $urls]
  1407.     lappend modifiedModeVars {URLs HTMLmodeVars}
  1408.     htmlEnableURLs [expr ([llength $HTMLmodeVars(URLs)] > 0)]
  1409.     message "Files added to URL cache."
  1410. }
  1411.  
  1412.  
  1413. #===============================================================================
  1414. #  Footers
  1415. #===============================================================================
  1416.  
  1417. proc htmlFooters {} {
  1418.     global HTMLmodeVars modifiedModeVars
  1419.     
  1420.     set footers [lsort $HTMLmodeVars(footers)]
  1421.     set touchedIt 0
  1422.     set this ∞
  1423.     while {1} {
  1424.         set box "-t {Footers:} 10 10 80 30 \
  1425.         -t Path: 30 50 80 70 \
  1426.         -b OK 10 110 75 130 -b Cancel 90 110 155 130 -b New… 170 110 235 130"
  1427.         if {[llength $footers]} {
  1428.             set foot ""
  1429.             foreach f $footers {
  1430.                 lappend foot [file tail $f]
  1431.             }
  1432.             append box " -m [list [concat [list $this] $foot]] 90 10 440 30"
  1433.             append box " -b Remove 250 110 315 130 -b Insert 330 110 395 130"
  1434.             foreach f $footers {
  1435.                 lappend box -n [file tail $f] -t $f 90 50 440 90
  1436.             }
  1437.         } else {
  1438.             append box  " -m {{None defined} {None defined}} 90 10 440 30"
  1439.         }
  1440.         set values [eval [concat dialog -w 450 -h 140 $box]]
  1441.         set this [lindex $values 3]
  1442.         if {[lindex $values 0]} {
  1443.             set HTMLmodeVars(footers) $footers
  1444.             lappend modifiedModeVars {footers HTMLmodeVars}
  1445.             return
  1446.         } elseif {[lindex $values 1]} {
  1447.             if {!$touchedIt || [askyesno "Really cancel without saving changes?"] == "yes"} {return}
  1448.         } elseif {[lindex $values 2]} {
  1449.             if {![catch {htmlNewFooter $footers} newfoot]} {
  1450.                 lappend footers $newfoot
  1451.                 set footers [lsort $footers]
  1452.                 set this [file tail $newfoot]
  1453.                 set touchedIt 1
  1454.             }
  1455.         } else {
  1456.             set i [lsearch -exact $foot $this]
  1457.             set footerFile [lindex $footers $i]
  1458.             if {[lindex $values 5]} {
  1459.                 if {![catch {readFile $footerFile} footText]} {
  1460.                     insertText "\r$footText\r"
  1461.                     set HTMLmodeVars(footers) $footers
  1462.                     lappend modifiedModeVars {footers HTMLmodeVars}
  1463.                     message "$this inserted."
  1464.                     return
  1465.                 } else {
  1466.                     alertnote "Could not read $this."
  1467.                 }
  1468.             } else {
  1469.                 set footers [lreplace $footers $i $i]
  1470.                 set touchedIt 1
  1471.             }
  1472.         }
  1473.     }    
  1474. }
  1475.  
  1476. # Define a file as a footer.
  1477. proc htmlNewFooter {footers} {
  1478.     set newFooter [getfile "Select the file with the footer."]
  1479.     if {![htmlIsTextFile $newFooter alertnote]} {
  1480.         error ""
  1481.     } elseif {[lsearch -exact $footers $newFooter] < 0} {
  1482.         # Can't define two footers with the same file name.
  1483.         foreach f $footers {
  1484.             if {[file tail $f] == [file tail $newFooter]} {
  1485.                 alertnote "There is already a footer with the filename\
  1486.                 '[file tail $newFooter]'. Two footers with the same filename\
  1487.                 cannot be defined."
  1488.                 error ""
  1489.             }
  1490.         }
  1491.         return $newFooter
  1492.     } else {
  1493.         alertnote "'[file tail $newFooter]' already a footer."
  1494.         error ""
  1495.     }
  1496. }
  1497.  
  1498.  
  1499. #===============================================================================
  1500. # Last modified
  1501. #===============================================================================
  1502.  
  1503. proc htmlLastModified {} {
  1504.     global HTMLmodeVars
  1505.     set values [dialog -w 300 -h 190 -t "Last modified tags" 40 10 200 30 \
  1506.     -e $HTMLmodeVars(lastModified) 10 40 290 55 -t "Date format" 10 70 100 90 \
  1507.     -r "Long" 1 10 95 70 115 -r "Abbreviated" 0 80 95 180 115 -r "Short" 0 190 95 250 115 \
  1508.     -c "Include weekday" 0 10 120 150 140 -c "Include time" 0 160 120 290 140 \
  1509.     -b OK 20 160 85 180 -b Cancel 110 160 175 180]
  1510.     if {[lindex $values 7]} {return}
  1511.     set lm [htmlQuote [lindex $values 0]]
  1512.     set indent [htmlFindNextIndent]
  1513.     set text "<!-- [htmlSetCase "#LASTMODIFIED TEXT"]=\"$lm\" [htmlSetCase FORM]=\""
  1514.     if {[lindex $values 1]} {append text [htmlSetCase LONG]}
  1515.     if {[lindex $values 2]} {append text [htmlSetCase ABBREV]}
  1516.     if {[lindex $values 3]} {append text [htmlSetCase SHORT]}
  1517.     if {[lindex $values 4]} {append text [htmlSetCase ",WEEKDAY"]}
  1518.     if {[lindex $values 5]} {append text [htmlSetCase ",TIME"]}
  1519.     append text "\" -->"
  1520.     set text "$text\r$indent[htmlGetLastMod $text]\r$indent<!-- [htmlSetCase /#LASTMODIFIED] -->"
  1521.     if {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#LASTMODIFIED[ \t\r]+[^>]+>} 0} res] &&
  1522.     ![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#LASTMODIFIED[ \t\r]+[^>]+>} [lindex $res 1]} res2]} {
  1523.         if {[askyesno "There are already 'last modified' tags in this document. Replace them?"] == "yes"} {
  1524.             replaceText [lindex $res 0] [lindex $res2 1] $text
  1525.         }
  1526.     } else {
  1527.         insertText [htmlOpenCR $indent 1] $text "\r$indent\r$indent"
  1528.     }
  1529. }
  1530.  
  1531. proc htmlUpdateLastMod {args} {
  1532.     set name [lindex $args [expr [llength $args] - 1]]
  1533.     if {[lindex [winNames -f] 0] != $name} {bringToFront $name}
  1534.     if {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#LASTMODIFIED[ \t\r]+[^>]+>} 0} res]} {
  1535.         if {[catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#LASTMODIFIED[ \t\r]+[^>]+>} [lindex $res 1]} res2]} {
  1536.             alertnote "The window '[file tail $name]' contains an opening 'last modified' tag without a matching closing tag."
  1537.             return
  1538.         }
  1539.         set str [htmlGetLastMod [getText [lindex $res 0] [expr [lindex $res 1] + 1]]]
  1540.         if {$str == "0"} {
  1541.             alertnote "The window '[file tail $name]' contains invalid 'last modified' tags."
  1542.         } else {
  1543.             set indent [htmlFindIndent [lindex $res 0]]
  1544.             replaceText [lindex $res 1] [lindex $res2 0] "\r" $indent $str "\r" $indent
  1545.         }
  1546.     }
  1547. }
  1548.  
  1549. proc htmlGetLastMod {str} {
  1550.     global htmlSpecialCharacter htmlSpecialCapCharacter
  1551.     set text ""
  1552.     set form ""
  1553.     set type ""
  1554.     if {![regexp -nocase {TEXT=\"([^\"]*)\"} $str dum text] ||
  1555.     ![regexp -nocase {FORM=\"([^\"]*)\"} $str dum form] || $form == "" ||
  1556.     ![regexp -nocase {[^,]*} $form type] || 
  1557.     [lsearch -exact [list LONG ABBREV SHORT] [string toupper $type]] < 0} {return 0}
  1558.     set text [htmlUnQuote $text]
  1559.     set day [string match "*WEEKDAY*" [string toupper $form]]
  1560.     set tid [string match "*TIME*" [string toupper $form]]
  1561.     set date [mtime [now] [string tolower $type]]
  1562.     if {!$day && [string toupper $type] != "SHORT"} {
  1563.         set date [lreplace $date 0 0 [lrange [lindex $date 0] 1 end]]
  1564.     }
  1565.     if {!$tid} {
  1566.         set date [lindex $date 0]
  1567.     } else {
  1568.         set tiden [lindex $date 1]
  1569.         regexp {^[0-9]+[^0-9]+[0-9]+} $tiden tidstr
  1570.         set tiden [lreplace $tiden 0 0 $tidstr]
  1571.         set date [lreplace $date 1 1 $tiden]
  1572.     }
  1573.     set text "$text [join $date]"
  1574.     regsub -all "&" $text "\\&" text
  1575.     regsub -all "<" $text "\\<" text
  1576.     regsub -all ">" $text "\\>" text
  1577.     regsub -all "¿" $text "\\¿" text
  1578.     regsub -all "¡" $text "\\¡" text
  1579.     foreach c [array names htmlSpecialCharacter] {
  1580.         regsub -all $c $text "\\&$htmlSpecialCharacter($c);" text
  1581.     }
  1582.     foreach c [array names htmlSpecialCapCharacter] {
  1583.         regsub -all $c $text "\\&$htmlSpecialCapCharacter($c);" text
  1584.     }
  1585.     foreach c [list eth ETH thorn THORN] {
  1586.         regsub -all "&$c;" $text $c text
  1587.     }
  1588.     return $text
  1589. }
  1590.  
  1591. #===============================================================================
  1592. # Home page windows
  1593. #===============================================================================
  1594.  
  1595. proc htmlOpenHPwin {{folder ""}} {
  1596.     global htmlHomePageWinList
  1597.     # Get folder to open.
  1598.     if {$folder == "" && [catch {htmlGetDir "Open:"} folder]} {return}
  1599.     set tail [file tail $folder]
  1600.     # Is their already a window for this folder?
  1601.     foreach win $htmlHomePageWinList {
  1602.         if {[lindex $win 0] == $folder} {
  1603.             bringToFront [lindex $win 1]
  1604.             return
  1605.         }    
  1606.     }
  1607.     if {[catch {glob $folder:*} fileList]} {beep; message "Empty folder."; return}
  1608.     
  1609.     set text "$folder\rcmd-shift-C to copy URL\r"
  1610.     foreach fil $fileList {
  1611.         append text [file tail $fil] \r
  1612.     }
  1613.     if {[set winsize [htmlGetHPwinSize $folder]] == ""} {
  1614.         new -n $tail -m Home
  1615.     } else {
  1616.         eval new -n [list "$tail"] -g $winsize -m Home
  1617.     }
  1618.     insertText $text
  1619.     if {$winsize == ""} {shrinkWindow 1}
  1620.     # make folders boldface
  1621.     for {set i 0} {$i < [llength $fileList]} {incr i} {
  1622.         set fil [lindex $fileList $i]
  1623.         if {[file isdirectory $fil]} {
  1624.             insertColorEscape [rowColToPos [expr $i + 3] 0] bold
  1625.             insertColorEscape [rowColToPos [expr $i + 4] 0] 12
  1626.         }
  1627.     }
  1628.     htmlSetWin
  1629.     lappend htmlHomePageWinList [list $folder [lindex [winNames] 0]]
  1630. }
  1631.  
  1632. # Reads a saved home page window size.
  1633. proc htmlGetHPwinSize {folder} {
  1634.     global PREFS htmlHPwinPositions
  1635.     if {[info exists htmlHPwinPositions($folder)]} {return $htmlHPwinPositions($folder)}
  1636.     if {![file exists "$PREFS:HTML:Home page window positions"]} {return}
  1637.     set cid [scancontext create]
  1638.     set pos ""
  1639.     scanmatch $cid "^\{?$folder\[ \}\]" {
  1640.         if {[lindex $matchInfo(line) 0] == $folder} {set pos [lrange $matchInfo(line) 1 end]}
  1641.     }
  1642.     set fid [open "$PREFS:HTML:Home page window positions"]
  1643.     scanfile $cid $fid
  1644.     close $fid
  1645.     scancontext delete $cid
  1646.     return $pos
  1647. }
  1648.  
  1649. proc htmlQuitHook {} {
  1650.     global PREFS htmlHPwinPositions
  1651.     if {![info exists htmlHPwinPositions]} {return}
  1652.     message "Saving home page window positions…"
  1653.     set current ""
  1654.     if {[file exists "$PREFS:HTML:Home page window positions"] && 
  1655.     ![catch {open "$PREFS:HTML:Home page window positions"} fid]} {
  1656.         set current [split [read -nonewline $fid] \n]
  1657.         close $fid
  1658.     }
  1659.     foreach c $current {
  1660.         if {[info exists htmlHPwinPositions([lindex $c 0])]} {
  1661.             append n [lrange $c 0 0] " " $htmlHPwinPositions([lindex $c 0]) \n
  1662.             unset htmlHPwinPositions([lindex $c 0])
  1663.         } else {
  1664.             append n $c \n
  1665.         }
  1666.     }
  1667.     foreach c [array names htmlHPwinPositions] {
  1668.         append n [list $c] " " $htmlHPwinPositions($c) \n
  1669.     }
  1670.     if {![catch {open "$PREFS:HTML:Home page window positions" w} fid]} {
  1671.         puts -nonewline $fid $n
  1672.         close $fid
  1673.     }
  1674. }
  1675.  
  1676.  
  1677. # Quick search in home page windows just like in Finder windows.
  1678. proc htmlSearchInHPwin {char} {
  1679.     global homeTime hpWinString
  1680.     set t [ticks]
  1681.     if {[expr $t - $homeTime] > 60} {set hpWinString ""}
  1682.     append hpWinString $char
  1683.     set homeTime $t
  1684.     if {[catch {search -s -f 1 -m 0 -r 1 -i 1 "^$hpWinString" [nextLineStart [nextLineStart 0]]} res]} {return}
  1685.     select [lindex $res 0] [nextLineStart [lindex $res 1]]
  1686. }
  1687.  
  1688. proc htmlHomeReturn {} {
  1689.     global htmlHomePageWinList HTMLmodeVars
  1690.     foreach win $htmlHomePageWinList {
  1691.         if {[lindex [winNames] 0] == [lindex $win 1]} {
  1692.             set f [htmlGetAhpLine]
  1693.             if {![file exists $f]} {alertnote "[file tail $f] not found."; return}
  1694.             if {[file isdirectory $f]} {
  1695.                 htmlOpenHPwin $f
  1696.             } else {
  1697.                 getFileInfo $f a
  1698.                 if {$a(type) == "TEXT"} {
  1699.                     edit -c $f
  1700.                 } elseif {$HTMLmodeVars(homeOpenNonTextFile)} {
  1701.                     if {$a(type) == "APPL"} {
  1702.                         launch -f $f
  1703.                     } elseif {$a(creator) == "MACS"} {
  1704.                         beep; message "Cannot open."
  1705.                     } else {
  1706.                         launchDoc $f
  1707.                     }
  1708.                 } else {
  1709.                     beep; message "Not a text file."
  1710.                 }
  1711.             }
  1712.             return
  1713.         }
  1714.     }    
  1715. }
  1716.  
  1717. proc htmlHpWinBack {} {
  1718.     global htmlHomePageWinList
  1719.     foreach win $htmlHomePageWinList {
  1720.         if {[lindex [winNames] 0] == [lindex $win 1]} {
  1721.             set folder [file dirname [getText 0 [expr [nextLineStart 0] - 1]]]
  1722.             if {$folder != ""} {htmlOpenHPwin $folder}
  1723.             return
  1724.         }
  1725.     }
  1726. }
  1727.  
  1728. proc htmlGetAhpLine {} {
  1729.     return "[getText 0 [expr [nextLineStart 0] - 1]]:[getText [lineStart [getPos]] [expr [nextLineStart [getPos]] - 1]]"
  1730. }
  1731.  
  1732. # Refreshes a Home page window.
  1733. proc htmlRefreshHpWin {{hpwin ""}} {
  1734.     global htmlHomePageWinList
  1735.     if {$hpwin == ""} {
  1736.         foreach win $htmlHomePageWinList {
  1737.             if {[lindex [winNames] 0] == [lindex $win 1]} {
  1738.                 set hpwin $win
  1739.             }
  1740.         }
  1741.     }
  1742.     set curSel [file tail [htmlGetAhpLine]]
  1743.     set folder [lindex $hpwin 0]
  1744.     setWinInfo read-only 0
  1745.     if {![file exists ${folder}:] || [catch {glob $folder:*} files]} {killWindow; return}
  1746.     set len [llength $files]
  1747.     set pos [nextLineStart [nextLineStart 0]]
  1748.     set ind 0
  1749.     while {$pos < [maxPos] && $ind < $len} {
  1750.         set f [file tail [lindex $files $ind]]
  1751.         set t [string trim [getText $pos [nextLineStart $pos]]]
  1752.         while {$pos < [maxPos] && $ind < $len && $t == $f} {
  1753.             incr ind
  1754.             set pos [nextLineStart $pos]
  1755.             set f [file tail [lindex $files $ind]]
  1756.             set t [string trim [getText $pos [nextLineStart $pos]]]
  1757.         }
  1758.         if {[string compare [string tolower $t] [string tolower $f]] == 1} {
  1759.             goto $pos
  1760.             insertText $f \r
  1761.             if {[file isdirectory [lindex $files $ind]]} {
  1762.                 insertColorEscape $pos bold
  1763.                 if {![file isdirectory [lindex $files [expr $ind + 1]]]} {
  1764.                     insertColorEscape [nextLineStart $pos] 12
  1765.                 }
  1766.             } elseif {[file isdirectory [lindex $files [expr $ind + 1]]]} {
  1767.                 insertColorEscape $pos 12
  1768.                 insertColorEscape [nextLineStart $pos] bold
  1769.             }            
  1770.             set pos [nextLineStart $pos]
  1771.             incr ind
  1772.         } else {
  1773.             deleteText $pos [nextLineStart $pos]
  1774.         }
  1775.         if {$pos < [maxPos]} {set t [string trim [getText $pos [nextLineStart $pos]]]}
  1776.         set f [file tail [lindex $files $ind]]
  1777.     }
  1778.     if {$pos < [maxPos]} {
  1779.         deleteText [expr $pos - 1] [maxPos]
  1780.     } else {
  1781.         goto [maxPos]
  1782.         foreach f [lrange $files $ind end] {
  1783.             insertText [file tail $f] \r
  1784.             if {[file isdirectory $f]} {
  1785.                 insertColorEscape $pos bold
  1786.                 insertColorEscape [nextLineStart $pos] 12
  1787.             }
  1788.             set pos [nextLineStart $pos]    
  1789.         }
  1790.     }
  1791.     refresh
  1792.     setWinInfo dirty 0
  1793.     setWinInfo read-only 1
  1794.     beginningOfBuffer
  1795.     if {![catch {search -s -f 1 -m 0 -r 1 -- "^$curSel" 0} res]} {
  1796.         select [lindex $res 0] [nextLineStart [lindex $res 1]]
  1797.     }
  1798. }
  1799.  
  1800. proc htmlRefreshWindows {} {
  1801.     global htmlHomePageWinList
  1802.     set frontWin [lindex [winNames -f] 0]
  1803.     foreach win $htmlHomePageWinList {
  1804.         bringToFront [lindex $win 1]
  1805.         htmlRefreshHpWin $win
  1806.     }
  1807.     bringToFront $frontWin
  1808. }
  1809.  
  1810. # Copies an URL from a home page window.
  1811. proc htmlCopyURL {} {
  1812.     global htmlHomePageWinList htmlHomePageWinURL
  1813.     foreach win $htmlHomePageWinList {
  1814.         if {[lindex [winNames] 0] == [lindex $win 1]} {
  1815.             set htmlHomePageWinURL [htmlGetAhpLine]
  1816.             message "$htmlHomePageWinURL copied."
  1817.         }
  1818.     }
  1819. }
  1820.  
  1821. # Pastes a previously copied URL from a home page window.
  1822. proc htmlPasteURL {} {
  1823.     global htmlHomePageWinURL htmlIsSel htmlCurSel HTMLmodeVars elecStopMarker
  1824.     if {![info exists htmlHomePageWinURL]} {message "No URL to paste."; return}
  1825.     if {[set link [htmlGetFile 0 $htmlHomePageWinURL 2]] == ""} {return}
  1826.     set url [htmlURLescape2 [lindex $link 0]]
  1827.     htmlGetSel
  1828.     set absPos [getPos]
  1829.     set htmlWrapPos [posX [getPos]]
  1830.     if {[llength [set wh [lindex $link 1]]]} {
  1831.         set text [htmlSetCase <IMG]
  1832.         append text [htmlWrapTag "[htmlSetCase SRC=]\"$url\""]
  1833.         append text [htmlWrapTag [htmlSetCase "WIDTH=\"[lindex $wh 0]\""]]
  1834.         append text [htmlWrapTag [htmlSetCase "HEIGHT=\"[lindex $wh 1]\">"]]
  1835.         set closing ""
  1836.     } else {
  1837.         set text "<[htmlSetCase A]"
  1838.         append text [htmlWrapTag [htmlSetCase HREF=]\"$url\">]
  1839.         set closing [htmlCloseElem A]
  1840.         if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append closing $elecStopMarker}
  1841.     }
  1842.     append text $htmlCurSel
  1843.     set currpos [expr [getPos] + [string length $text]]
  1844.     append text $closing
  1845.     if {$htmlIsSel} { deleteSelection }
  1846.     insertText $text
  1847.     if {!$htmlIsSel} {
  1848.         goto $currpos
  1849.     }
  1850. }
  1851.  
  1852.  
  1853. # closeHook
  1854. proc htmlCloseHook {name} {
  1855.     global htmlHomePageWinList
  1856.     set tmp ""
  1857.     foreach win $htmlHomePageWinList {
  1858.         if {$name != [lindex $win 1]} {
  1859.             lappend tmp $win
  1860.         }
  1861.     }
  1862.     set htmlHomePageWinList $tmp
  1863. }
  1864.  
  1865. # deactivateHook
  1866. proc htmldeactivateHook {name} {
  1867.     global htmlHPwinPositions
  1868.     set winSize [getGeometry]
  1869.     # When closing size is {0 0 0 0}
  1870.     if {$winSize == {0 0 0 0}} {return}
  1871.     set htmlHPwinPositions([string trim [getText 0 [nextLineStart 0]]]) $winSize
  1872. }
  1873.  
  1874. namespace eval Home {}
  1875. proc Home::DblClick {from to} {htmlHomeReturn}
  1876.  
  1877. foreach __char {a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 . _ -} {
  1878.     bind '$__char' "htmlSearchInHPwin $__char" Home
  1879. }
  1880. unset __char
  1881.  
  1882. bind '\r' htmlHomeReturn Home
  1883. bind down <c> htmlHomeReturn Home
  1884. bind enter htmlHomeReturn Home
  1885. bind down     downBrowse Home
  1886. bind up     upBrowse Home
  1887. bind '\r' <c> htmlHpWinBack Home
  1888. bind enter <c> htmlHpWinBack Home
  1889. bind up <c> htmlHpWinBack Home
  1890. bind 'r' <c> htmlRefreshHpWin Home
  1891. bind 'c' <cs> htmlCopyURL Home
  1892.  
  1893.  
  1894. #===============================================================================
  1895. # Validation
  1896. #===============================================================================
  1897.  
  1898. proc htmlFindUnbalancedTags {} {
  1899.     global tileLeft tileTop tileWidth errorHeight
  1900.     
  1901.     message "Searching for unbalanced tags…"
  1902.     set fil [stripNameCount [lindex [winNames -f] 0]]
  1903.     # These may not have an closing tag.
  1904.     set empty {!DOCTYPE BASEFONT BR AREA LINK IMG PARAM HR INPUT ISINDEX BASE META}
  1905.     lappend empty  COL FRAME SPACER WBR EMBED BGSOUND KEYGEN
  1906.     # These have an optional closing tag.
  1907.     set closingOptional {P DT DD LI OPTION TR TD TH HEAD BODY HTML WINDOW}
  1908.     lappend closingOptional COLGROUP THEAD TBODY TFOOT
  1909.     # These have an optional opening tag.
  1910.     set openingOptional {HTML HEAD BODY}
  1911.     lappend openingOptional TBODY
  1912.     
  1913.     set tagStack WINDOW
  1914.     set pos 0
  1915.     while {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<!--|<[^<>]+>} $pos} res]} {
  1916.         set tagstart [lindex $res 0]
  1917.         set tagend   [lindex $res 1]
  1918.         set tagtxt [getText $tagstart $tagend]
  1919.         if {$tagtxt == "<!--"} {
  1920.             # Comment
  1921.             if {![catch {search -s -f 1 -r 0 -m 0 -- {-->} $tagstart} res]} {
  1922.                 set pos [lindex $res 1]
  1923.             } else {
  1924.                 set pos [maxPos]
  1925.             }
  1926.             continue
  1927.         }
  1928.         # get element name
  1929.         if {![regexp {<[ \t\r]*([^ \t\r]+).*>} $tagtxt tmp tag]} {
  1930.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Empty <>.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  1931.             set pos $tagend
  1932.             continue
  1933.         }
  1934.         set tag [string toupper $tag]
  1935.         # is this a closing tag?
  1936.         if {[string index $tag 0] == "/"} {
  1937.             set tag [string range $tag 1 end]
  1938.             if {[lsearch -exact $empty $tag] >= 0} {
  1939.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag may mot have a closing tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  1940.             } elseif {[lsearch -exact $tagStack $tag] < 0 && [lsearch -exact $openingOptional $tag] < 0} {
  1941.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Closing $tag without a matching opening tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  1942.             } else {
  1943.                 for {set i 0} {$i < [llength $tagStack]} {incr i} {
  1944.                     if {[set this [lindex $tagStack $i]] != $tag} {
  1945.                         if {[lsearch -exact $closingOptional $this] < 0} {
  1946.                             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $this must be closed before $tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  1947.                         }
  1948.                     } else {
  1949.                         break
  1950.                     }
  1951.                 }
  1952.                 set tagStack [lrange $tagStack [expr $i + 1 ] end]
  1953.             }
  1954.         } else {
  1955.             # opening tag
  1956.             if {[lsearch -exact $empty $tag] < 0} {
  1957.                 set tagStack [concat $tag $tagStack]
  1958.             }
  1959.         }
  1960.         set pos $tagend
  1961.     }
  1962.     # check if there are unclosed tags.
  1963.     for {set i 0} {$i < [llength $tagStack]} {incr i} {
  1964.         if {[lsearch -exact $closingOptional [set this [lindex $tagStack $i]]] < 0} {
  1965.             append errtxt "Line [lindex [posToRowCol [maxPos]] 0] : $this must be closed before HTML.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  1966.         }
  1967.     }
  1968.     if {[info exists errtxt]} {
  1969.         new -n "* Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  1970.         insertText "Errors:  (<uparrow> and <downarrow> to browse, <return> to go to file)\r\r"
  1971.         insertText $errtxt
  1972.         htmlSetWin
  1973.     } else {
  1974.         alertnote "No unbalanced tags found!"
  1975.     }
  1976.  
  1977. }
  1978.  
  1979. proc htmlCheckTags {} {
  1980.     global tileLeft tileTop tileWidth errorHeight
  1981.     
  1982.     message "Checking tags…"
  1983.     set fil [stripNameCount [lindex [winNames -f] 0]]
  1984.     
  1985.     htmlCheckConfig
  1986.     
  1987.     set doctype [htmlFindDoctype]
  1988.     # Remove some things depending on the doctype.
  1989.     if {$doctype == "transitional" || $doctype == "strict"} {
  1990.         regsub "FRAME" $empty "" empty
  1991.         unset mayContain(FRAMESET)
  1992.     }
  1993.     if {$doctype == "strict"} {
  1994.         foreach xxx {APPLET FONT CENTER DIR MENU STRIKE S U} {
  1995.             unset mayContain($xxx)
  1996.         }
  1997.         regsub -all "BASEFONT|ISINDEX" $empty "" empty
  1998.     }
  1999.     if {$doctype == "frameset"} {
  2000.         set mayContain(HTML) {HEAD FRAMESET}
  2001.     }
  2002.     
  2003.     # Validate
  2004.     set headHasBeen 0
  2005.     set bodyHasBeen 0
  2006.     set htmlHasBeen 0
  2007.     set tagStack WINDOW
  2008.     set currentTag WINDOW
  2009.     set pos 0
  2010.     while {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<!--|<[^<>]+>} $pos} res]} {
  2011.         set tagstart [lindex $res 0]
  2012.         set tagend   [lindex $res 1]
  2013.         set tagtxt [getText $tagstart $tagend]
  2014.         # get element name
  2015.         if {$tagtxt != "!--" && ![regexp {<[ \t\r]*([^ \t\r>]+)} $tagtxt tmp tag]} {
  2016.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Empty <>.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2017.             set pos $tagend
  2018.             continue
  2019.         } else {
  2020.             set tag [string toupper $tag]
  2021.         }
  2022.         if {$tagstart > $pos} {
  2023.             set prevTxt [getText $pos [expr $tagstart -1]]
  2024.         } else {
  2025.             set prevTxt ""
  2026.         }
  2027.         # check for unmatched < or > in text.
  2028.         if {[regexp {<} $prevTxt]} {
  2029.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Unmatched <.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2030.         }
  2031.         if {[regexp {>} $prevTxt]} {
  2032.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Unmatched >.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2033.         }
  2034.         
  2035.         # check for text if current element may not contain text.
  2036.         set back 0
  2037.         if {[lsearch -exact $mayContain($currentTag) text] < 0 &&
  2038.         ![regexp {^[ \t\r]*$} $prevTxt ]} {
  2039.             # back up and insert BODY if needed
  2040.             if {!$bodyHasBeen && [lsearch -exact $tagStack BODY] < 0 &&
  2041.             [lsearch -exact $tagStack FRAMESET] < 0} {
  2042.                 set tagend $pos
  2043.                 set tag BODY
  2044.                 set back 1
  2045.             } else {
  2046.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $currentTag may not contain text.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2047.             }
  2048.         }
  2049.         if {!$back && $tagtxt == "<!--"} {
  2050.             # Comment
  2051.             if {![catch {search -s -f 1 -r 0 -m 0 -- {-->} $tagstart} res]} {
  2052.                 set pos [lindex $res 1]
  2053.             } else {
  2054.                 set pos [maxPos]
  2055.             }
  2056.             continue
  2057.         }
  2058.         # Silently ignore !DOCTYPE
  2059.         if {$tag == "!DOCTYPE"} {
  2060.             set pos $tagend
  2061.             continue
  2062.         }
  2063.         # back up and insert HEAD if needed.
  2064.         if {!$headHasBeen && [lsearch -exact $mayContain(HEAD) $tag] >= 0} {
  2065.             set tagend $pos
  2066.             set tag HEAD
  2067.         }
  2068.         # back up and insert TBODY if needed
  2069.         if {$currentTag == "TABLE" && [lsearch -exact $mayContain(TABLE) $tag] < 0} {
  2070.             set tagend $pos
  2071.             set tag TBODY
  2072.         }
  2073.         set xtag [string trimleft $tag /]
  2074.         # insert BODY if tag can't be in HEAD or HEAD is closed.
  2075.         if {!$bodyHasBeen && ([lsearch -exact $mayContain(HEAD) $xtag] < 0 ||
  2076.         [lsearch -exact $tagStack HEAD] < 0) &&
  2077.         $xtag != "HTML" && $xtag != "HEAD" && $xtag != "BODY" && 
  2078.         !($xtag == "FRAMESET" || [lsearch -exact $tagStack FRAMESET] >= 0)} {
  2079.             set tagend $pos
  2080.             set tag BODY
  2081.         }
  2082.         # insert HTML if not done
  2083.         if {!$htmlHasBeen && $tag != "HTML"} {
  2084.             set tagend $pos
  2085.             set tag HTML
  2086.         }
  2087.         
  2088.         # check if there's anything after </HTML>
  2089.         if {$tag == "/HTML"} {
  2090.             if {![regexp {^([ \t\r\n]*|([ \t\r\n]*<!--[^>]*-->)*[ \t\r\n]*)$} [getText $tagend [maxPos]]]} {
  2091.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Text after </HTML>.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2092.             }
  2093.             break
  2094.         }
  2095.         # is this a closing tag?
  2096.         if {[string index $tag 0] == "/"} {
  2097.             set tag [string range $tag 1 end]
  2098.             if {![info exists mayContain($tag)]} {
  2099.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag is unknown.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2100.             } else {
  2101.                 if {$tag == "HEAD" || $tag == "BODY"} {set headHasBeen 1}
  2102.                 if {$tag == "BODY"} {set bodyHasBeen 1}
  2103.                 if {[lsearch -exact $empty $tag] >= 0} {
  2104.                     append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag may mot have a closing tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2105.                 } elseif {[lsearch -exact $tagStack $tag] < 0} {
  2106.                     append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Closing $tag without a matching opening tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2107.                 } else {
  2108.                     for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2109.                         if {[set this [lindex $tagStack $i]] != $tag} {
  2110.                             if {[lsearch -exact $closingOptional $this] < 0} {
  2111.                                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $this must be closed before $tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2112.                             }
  2113.                         } else {
  2114.                             break
  2115.                         }
  2116.                     }
  2117.                     set tagStack [lrange $tagStack [expr $i + 1 ] end]
  2118.                     set currentTag [lindex $tagStack 0]
  2119.                 }
  2120.             }
  2121.         } else {
  2122.             # opening tag
  2123.             if {$headHasBeen && $tag == "HEAD"} {
  2124.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Multiple HEAD tags.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2125.             } 
  2126.             if {$bodyHasBeen && $tag == "BODY" && !($currentTag == "NOFRAMES" && $doctype == "frameset")} {
  2127.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Multiple BODY tags.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2128.             }
  2129.             if {$htmlHasBeen && $tag == "HTML"} {
  2130.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Multiple HTML tags.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2131.             }
  2132.             if {$tag == "HEAD" || $tag == "BODY"} {set headHasBeen 1}
  2133.             if {$tag == "BODY"} {set bodyHasBeen 1}
  2134.             if {$tag == "HTML"} {set htmlHasBeen 1}
  2135.             # unknown tag?
  2136.             if {[set em [lsearch -exact $empty $tag]] < 0 && ![info exists mayContain($tag)]} {
  2137.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag is unknown.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2138.             } else {
  2139.                 # implicitely close those which may not contain $tag.
  2140.                 for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2141.                     set this [lindex $tagStack $i]
  2142.                     if {[lsearch -exact $mayContain($this) $tag] < 0} {
  2143.                         # Silently close those with an optional closing tag except BODY and HTML.
  2144.                         if {[lsearch -exact $closingOptional $this] < 0 || $this == "BODY" || $this == "HTML"} {
  2145.                             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $this may not contain $tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2146.                             break
  2147.                         }
  2148.                     } else {
  2149.                         break
  2150.                     }
  2151.                 }
  2152.                 if {$em < 0} {
  2153.                     set tagStack [concat $tag [lrange $tagStack $i end]]
  2154.                     set currentTag $tag
  2155.                 } else {
  2156.                     set tagStack [lrange $tagStack $i end]
  2157.                 }
  2158.             }
  2159.         }
  2160.         set pos $tagend
  2161.     }
  2162.     # check if there are unclosed tags.
  2163.     for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2164.         if {[lsearch -exact $closingOptional [set this [lindex $tagStack $i]]] < 0} {
  2165.             append errtxt "Line [lindex [posToRowCol [maxPos]] 0] : $this must be closed before HTML.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2166.         }
  2167.     }
  2168.     if {[info exists errtxt]} {
  2169.         new -n "* Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  2170.         insertText "Errors:  (<uparrow> and <downarrow> to browse, <return> to go to line)\r\r"
  2171.         insertText $errtxt
  2172.         htmlSetWin
  2173.     } else {
  2174.         alertnote "No syntax errors found! (Attributes have not been checked.)"
  2175.     }
  2176. }
  2177.